library(tidyverse)
library(textrecipes)
library(tidymodels)
library(tidytext)25 Многоклассовая классификация
Многоклассовая классификация может использоваться для определения автора, жанра, тематики или эмоциональной тональности текста.
25.1 Данные
https://www.kaggle.com/datasets/mikhailklemin/kinopoisks-movies-reviews
path_neg <- list.files("../files/kinopoisk/neg", full.names = TRUE)
path_pos <- list.files("../files/kinopoisk/pos", full.names = TRUE)
path_neu <- list.files("../files/kinopoisk/neu", full.names = TRUE)
# для ускорения вычислений на занятии
path_sel <- c(path_neg[1:1000], path_pos[1:1000], path_neu[1:1000])read_review <- function(path) {
tibble(review = read_lines(path) |>
str_c(collapse = " "),
sentiment = str_extract(path, "pos|neg|neu"))
}
reviews <- map_df(path_sel, read_review)
reviews25.2 Разведывательный анализ
В нашем датасете есть несколько очень коротких рецензий. Негативные рецензии в целом длиннее позитивных и нейтральных.
reviews |>
mutate(n_words = str_count(review, " ") + 1) |>
ggplot(aes(n_words, fill = sentiment)) +
geom_histogram(bins = 100) +
xlab(NULL) +
ylab(NULL) +
scale_fill_viridis_d() +
theme_light()
Посмотрим на число уникальных токенов в каждой из категорий.
reviews_tokens <- reviews |>
mutate(id = row_number(), .before = sentiment) |>
unnest_tokens(token, review)
reviews_tokens |>
group_by(sentiment) |>
summarise(n = n_distinct(token))Большая часть слов встречается очень редко.
reviews_tokens |>
count(sentiment, token) |>
ggplot(aes(n, fill = sentiment)) +
geom_histogram(show.legend = FALSE, bins = 1000) +
coord_cartesian(xlim = c(NA, 2500), ylim = c(NA, 2500)) +
theme_light() +
scale_fill_viridis_d()
Здесь можно добавить пример из https://juliasilge.com/blog/nber-papers/.
25.3 Обучающая и тестовая выборки
set.seed(09032025)
data_split <- reviews |>
mutate(sentiment = as.factor(sentiment)) |>
initial_split( strata = sentiment)
data_train <- training(data_split)
data_test <- testing(data_split)# folds
set.seed(09032025)
folds <- vfold_cv(data_train, strata = sentiment, v = 5)
folds25.4 Рецепт для препроцессинга
library(stopwords)
stopwords_ru <- c(
stopwords("ru", source = "snowball"),
stopwords("ru", source = "marimo"),
stopwords("ru", source = "nltk"))
# уберем повторы и упорядочим по алфавиту
stopwords_ru <- sort(unique(stopwords_ru))
length(stopwords_ru)[1] 380
Подробнее о рецепте см. https://smltar.com/mlregression#firstregression
tfidf_rec <- recipe(sentiment ~ review, data = data_train) |>
step_mutate(review = stringr::str_remove_all(review, "\\d+")) |>
step_mutate(review = stringr::str_remove_all(review, "[A-Za-z]")) |>
step_tokenize(review) |>
step_stopwords(review, custom_stopword_source = stopwords_ru) |>
step_stem(review, options = list(language = "russian")) |>
step_tokenfilter(all_predictors(),
max_tokens = 1000,
min_times = 2) |>
step_tfidf(review) |>
step_zv(all_predictors()) |>
step_normalize(all_predictors())
tfidf_rec
── Recipe ──────────────────────────────────────────────────────────────────────
── Inputs
Number of variables by role
outcome: 1
predictor: 1
── Operations
• Variable mutation for: stringr::str_remove_all(review, "\\d+")
• Variable mutation for: stringr::str_remove_all(review, "[A-Za-z]")
• Tokenization for: review
• Stop word removal for: review
• Stemming for: review
• Text filtering for: all_predictors()
• Term frequency-inverse document frequency with: review
• Zero variance filter on: all_predictors()
• Centering and scaling for: all_predictors()
25.5 Результат препроцессинга
prep_train_tfidf <- tfidf_rec |>
prep(data_train)
tidy(prep_train_tfidf)bake_train_tfidf <- prep_train_tfidf |>
bake(new_data = NULL)
bake_train_tfidf